home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d893.lha / Clouds / UNIT-SOURCE / IFF_UNIT.pas next >
Pascal/Delphi Source File  |  1993-01-24  |  5KB  |  186 lines
  1. UNIT iff;
  2.  
  3. INTERFACE
  4.  
  5.   USES Intuition, Graphics;
  6.  
  7.   CONST IffName           = "iff.library";
  8.         IffVersion        = 16;
  9.         IFF_BADTASK       = -1;
  10.         IFF_CANTOPENFILE  = 16;
  11.         IFF_READERROR     = 17;
  12.         IFF_NOMEM         = 18;
  13.         IFF_NOTIFF        = 19;
  14.         IFF_WRITEERROR    = 20;
  15.         IFF_NOILBM        = 24;
  16.         IFF_NOBMHD        = 25;
  17.         IFF_NOBODY        = 26;
  18.         IFF_TOOMANYPLANES = 27;
  19.         Komprimiert       = 1;
  20.         Unkomprimiert     = 0;
  21.         HAM               = %10000000;
  22.  
  23.   TYPE p_Chunk = ^Chunk;
  24.        Chunk = RECORD
  25.                  ckID  : LONG;
  26.                  ckSize: LONG;
  27.                  CkData: BYTE;
  28.                END;
  29.  
  30.        p_BitMapHeader = ^BitMapHeader;
  31.        BitMapHeader = RECORD
  32.                         w,h                 : INTEGER;
  33.                         x,y                 : INTEGER;
  34.                         nPlanes             : BYTE;
  35.                         masking             : BYTE;
  36.                         compression         : BYTE;
  37.                         pad1                : BYTE;
  38.                         transparentColor    : INTEGER;
  39.                         xAspect,yAspect     : BYTE;
  40.                         pageWidth,pageHeight: INTEGER;
  41.                       END;
  42.  
  43.   VAR iffbase     : PTR;
  44.  
  45.   LIBRARY iffbase:
  46.     -30 : FUNCTION  Openiff(a0: STR): PTR;
  47.     -36 : PROCEDURE Closeiff(a1: PTR);
  48.     -42 : FUNCTION  Findchunk(a1: PTR; d0: LONG): p_Chunk;
  49.     -48 : FUNCTION  GetBMHD(a1: PTR): p_BitMapHeader;
  50.     -54 : FUNCTION  GetColorTab(a1: PTR; a0: PTR): LONG;
  51.     -60 : FUNCTION  DecodePic(a1: PTR; a0: PTR): BOOLEAN;
  52.     -66 : FUNCTION  SaveBitMap(a0: STR; a1,a2: PTR; d0:LONG): BOOLEAN;
  53.     -72 : FUNCTION  SaveClip(a0: STR; a1,a2: PTR; d0: LONG;
  54.                              d1,d2,d3,d4: INTEGER): BOOLEAN;
  55.     -78 : FUNCTION  IffError: LONG;
  56.     -84 : FUNCTION  GetViewModes(a1: PTR): WORD;
  57.     -90 : FUNCTION  NewOpenIff(a0: STR; d0: LONG): PTR;
  58.   END;
  59.  
  60.   PROCEDURE Closedown;
  61.   PROCEDURE LoadPic(win: p_Window; PicName: STRING);
  62.   PROCEDURE SavePic(win: p_Window; PicName: STRING);
  63.   PROCEDURE SaveBrush(win: p_Window; PicName: STRING; x1,y1,x2,y2: INTEGER);
  64.  
  65. IMPLEMENTATION
  66.  
  67.   PROCEDURE Closedown;
  68.  
  69.   BEGIN
  70.     CloseLib(iffbase);
  71.   END;
  72.  
  73.   PROCEDURE LoadPic;
  74.  
  75.   VAR Colourtable : ARRAY [1..128] OF WORD;
  76.       Counter     : LONG;
  77.       Rp          : p_RastPort;
  78.       IFFFile     : PTR;
  79.       BMHD        : p_BitmapHeader;
  80.       Width,Height: INTEGER;
  81.  
  82.   LABEL Skipit;
  83.  
  84.   BEGIN
  85.     IFFFile:=NIL;
  86.     Rp:=Win^.RPort;
  87.     Width:=Win^.WScreen^.Width;
  88.     Height:=Win^.WScreen^.Height;
  89.     IF PicName<>"" THEN
  90.     BEGIN
  91.       SetAPen(Rp,0);
  92.       RectFill(Rp,0,0,Width,Height);
  93.       SetAPen(Rp,1);
  94.       IFFFile:=OpenIFF(PicName);
  95.       IF IFFFile=NIL THEN
  96.       BEGIN
  97.         WRITELN("Can't open file!!");
  98.         GOTO SkipIt;
  99.       END;
  100.       BMHD:=GetBMHD(IFFFile);
  101.       IF BMHD=NIL THEN
  102.       BEGIN
  103.         WRITELN("No BMHD-Chunk!!");
  104.         GOTO SkipIt;
  105.       END;
  106.       IF DecodePic(IFFFile,Rp^.BitMap) THEN
  107.       BEGIN
  108.         counter:=GetColorTab(IFFFile,^colourtable);
  109.         LoadRGB4(^win^.WScreen^.ViewPort,^colourtable,counter);
  110.       END
  111.       ELSE
  112.       BEGIN
  113.         WRITELN("No BODY-Chunk!!");
  114.         GOTO SkipIt;
  115.       END;
  116.       SkipIt:
  117.       IF IFFFile<>NIL THEN CloseIFF(IFFFile);
  118.     END;
  119.   END;
  120.  
  121.   PROCEDURE SavePic;
  122.  
  123.   CONST HOLDNMODIFY = $800;
  124.  
  125.   VAR ColorTab : PTR;
  126.       Scr      : p_Screen;
  127.       SOK      : BOOLEAN;
  128.       Rp       : p_RastPort;
  129.  
  130.   BEGIN
  131.     Scr:=Win^.WScreen;
  132.     ColorTab:=Scr^.ViewPort.ColorMap^.ColorTable;
  133.     Rp:=Win^.RPort;
  134.     IF PicName<>"" THEN
  135.     BEGIN
  136.       IF (HOLDNMODIFY AND Scr^.ViewPort.Modes)>0 THEN
  137.         SOK:=SaveBitMap(PicName,Rp^.BitMap,ColorTab,Komprimiert+HAM)
  138.       ELSE
  139.         SOK:=SaveBitMap(PicName,Rp^.BitMap,ColorTab,Komprimiert);
  140.       IF NOT SOK THEN WRITELN('Write Error!!');
  141.     END;
  142.   END;
  143.  
  144.   PROCEDURE SaveBrush;
  145.  
  146.   CONST HOLDNMODIFY = $800;
  147.  
  148.   VAR ColorTab : PTR;
  149.       Scr      : p_Screen;
  150.       SOK      : BOOLEAN;
  151.       Rp       : p_RastPort;
  152.  
  153.   BEGIN
  154.     Scr:=Win^.WScreen;
  155.     ColorTab:=Scr^.ViewPort.ColorMap^.ColorTable;
  156.     Rp:=Win^.RPort;
  157.     IF PicName<>"" THEN
  158.     BEGIN
  159.       IF (HOLDNMODIFY AND Scr^.ViewPort.Modes)>0 THEN
  160.         SOK:=SaveClip(PicName,Rp^.BitMap,ColorTab,Komprimiert+HAM,x1,y1,x2,y2)
  161.       ELSE
  162.         SOK:=SaveClip(PicName,Rp^.BitMap,ColorTab,Komprimiert,x1,y1,x2,y2);
  163.       IF NOT SOK THEN WRITELN('Write Error!!');
  164.     END;
  165.   END;
  166.  
  167.   BEGIN
  168.     OpenLib(iffbase,Iffname,Iffversion);
  169.     ADDEXITSERVER(CloseDown);
  170.     IF iffbase = NIL THEN
  171.     BEGIN
  172.       IF FromWB THEN
  173.       BEGIN
  174.         ASSIGN(INPUT, 'CON:50/100/540/60/Sorry :');
  175.         RESET(INPUT);
  176.         OUTPUT:=INPUT;
  177.         WRITELN("Couldn't open the ",Iffname," Version ",IffVersion,"!");
  178.         DELAY(100);
  179.       END
  180.       ELSE
  181.         WRITELN("Couldn't open the ",Iffname," Version",IffVersion, "!");
  182.       HALT(10);
  183.     END;
  184. END;
  185.  
  186.